Lo primero que tengo que hacer es importar el dataset que he creado
dataset <- read.csv("C:/Users/jorge/Desktop/Documentos Clase/Universidad/4ºCarrera/1er Cuatrimestre/Inteligencia Artificial/Trabajo Fin de Asignatura/datos.txt", header = TRUE)
Ahora lo que hago es pasarlo a una matriz, quitando tanto el nombre (que no me interesa) como la etiqueta (que no la necesito por ahora)
matriz.pacientes.etiquetas <- dataset[, -1]
matriz.pacientes.datos <- matriz.pacientes.etiquetas[, -25]
Primero compruebo que todos los datos tienen un tipo correcto.
sapply(matriz.pacientes.datos, class)
## edad sex rel_ctxo_rel_mala rel_ctxo_trauma
## "integer" "integer" "integer" "integer"
## rel_ctxo_buena ed_perm ed_norm ed_estr
## "integer" "integer" "integer" "integer"
## resil_ba resil_me resil_al pen_dic
## "integer" "integer" "integer" "integer"
## gen_ex etiq fil_men max_min
## "integer" "integer" "integer" "integer"
## conc_arb pseu_res deb raz_emo
## "integer" "integer" "integer" "integer"
## inhib asert agres impuls
## "integer" "integer" "integer" "integer"
Veo la media de la edad de los pacientes y el rango en el que se mueve
mean(matriz.pacientes.datos[, 1])
## [1] 26.46269
range(matriz.pacientes.datos[, 1])
## [1] 13 52
Finalmente, veo un resúmen de cada columna
summary(matriz.pacientes.datos)
## edad sex rel_ctxo_rel_mala rel_ctxo_trauma
## Min. :13.00 Min. :0.000 Min. :0.0000 Min. :0.0000
## 1st Qu.:19.50 1st Qu.:0.000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :25.00 Median :0.000 Median :0.0000 Median :0.0000
## Mean :26.46 Mean :0.209 Mean :0.1343 Mean :0.3582
## 3rd Qu.:30.50 3rd Qu.:0.000 3rd Qu.:0.0000 3rd Qu.:1.0000
## Max. :52.00 Max. :1.000 Max. :1.0000 Max. :1.0000
## rel_ctxo_buena ed_perm ed_norm ed_estr
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :1.0000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.5075 Mean :0.2836 Mean :0.4925 Mean :0.2239
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.0000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## resil_ba resil_me resil_al pen_dic
## Min. :0.0000 Min. :0.0000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:1.0000
## Median :1.0000 Median :0.0000 Median :0.00000 Median :1.0000
## Mean :0.5672 Mean :0.4179 Mean :0.01493 Mean :0.8955
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.00000 Max. :1.0000
## gen_ex etiq fil_men max_min
## Min. :0.0000 Min. :0.0000 Min. :0.000 Min. :0.0000
## 1st Qu.:1.0000 1st Qu.:0.5000 1st Qu.:1.000 1st Qu.:1.0000
## Median :1.0000 Median :1.0000 Median :1.000 Median :1.0000
## Mean :0.9552 Mean :0.7463 Mean :0.791 Mean :0.9701
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.000 Max. :1.0000
## conc_arb pseu_res deb raz_emo
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.000
## 1st Qu.:1.0000 1st Qu.:0.0000 1st Qu.:1.0000 1st Qu.:1.000
## Median :1.0000 Median :1.0000 Median :1.0000 Median :1.000
## Mean :0.9851 Mean :0.5075 Mean :0.9403 Mean :0.791
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.000
## inhib asert agres impuls
## Min. :0.0000 Min. :0.0000 Min. :0.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:0.0000
## Median :1.0000 Median :0.0000 Median :0.000 Median :1.0000
## Mean :0.6567 Mean :0.1343 Mean :0.209 Mean :0.6119
## 3rd Qu.:1.0000 3rd Qu.:0.0000 3rd Qu.:0.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.000 Max. :1.0000
Como se puede ver, los datos de los pacientes están muy distanciados, y además su media es muy alta. Así, la media de la edad difiere enormemente del resto de valores de la matriz. Debido a ello, debemos de hacer un preprocesado de los datos del problema.
Antes que este preprocesado,voy a hacer la visualización de algunas relaciones entre variables, de tal manera que podamos ver gráficamente algunos aspectos interesantes:
Ahora voy a sacar un plot para ver la relación entre la edad y el sexo de las personas que están en consulta
plot(matriz.pacientes.datos[,1], matriz.pacientes.datos[,2], xlab="Edad", ylab="Sexo (0 - mujer, 1 - hombre)", main="Edad & Sexo");
Otro plot para ver la correlación entre ser agresivo y ser impulsivo
#install.packages("hexbin")
#install.packages("RColorBrewer")
library(hexbin)
library(RColorBrewer)
rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 23], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Agresivo", ylab="Impulsivo", main="Agresivo Vs Impulsivo")
Otro plot similar para ver la relación de ser inhibido e impulsivo
df <- data.frame(matriz.pacientes.datos[, 21], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Inhibido", ylab="Impulsivo", main="Inhibido Vs Impulsivo")
Voy a ver la relación entre el razonamiento emocional (actuar según tus sentimientos) y la impulsividad
df <- data.frame(matriz.pacientes.datos[, 20], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Razonamiento Emocional", ylab="Impulsivo", main="Razonamiento Emocional Vs Impulsivo")
Ahora quiero sacar una relación entre ser agresivo y ver el grupo en el que están
rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 23], matriz.pacientes.etiquetas[, 25])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Agresivo", ylab="Grupo", main="Agresivo Y Grupo Real")
Voy a hacer lo mismo con la impulsividad
rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 24], matriz.pacientes.etiquetas[, 25])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Impulsivo", ylab="Grupo", main="Impulsivo y Grupo Real")
De estas gráficas estamos obteniendo información realmente interesante antes de la predicción de los datos. He preferido hacer gráficas en 2D porque las gráficas en 3D son mucho más difíciles de interpretar que estas bonitas gráficas en 2D
Vamos a ver la correlación que tienen mis variables
res <- cor(matriz.pacientes.datos[, 1:24], method = "spearman") # Por mi tipo de datos, hacemos la correlación por spearman
options(width = 100)
res.round <- round(res, 2)
Como saca una tabla enorme, lo que voy a hacer es usar una librería que me da una función para sacar de una forma bonita las correlaciones entre las variables.
#install.packages("corrplot")
library(corrplot)
## corrplot 0.84 loaded
corrplot(res.round, method="circle")
Como podemos ver, por ejemplo, resiliencia baja y media tienen una correlación de -1, ya que si hay una no hay la otra y viceversa. Esto pasa igual con las relaciones entre contexto, ya que buena - trauma, trauma - mala, mala - buena tienen que ser inversas.
Como he comentado antes, Lo que voy a hacer ahora es un centrado y escalado de los datos de la matriz. De esta manera, la red neuronal no tendrá ningún valor que destaque especialmente y con ello no dará de inicio más peso a unos valores que a otros, ya que no lo buscamos.
Lo primero que hacemos es importar la librería caret
#install.packages("caret")
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
Ahora hacemos un centrado y escalado de los datos, ya que la edad no sigue el rango del resto de valores, y distorsionaría la predicción
preObjeto <- preProcess(matriz.pacientes.datos, method=c("center", "scale")) # Quiero hacer un centrado y escalado
matriz.pacientes.datos.centscal <- predict(preObjeto, matriz.pacientes.datos) # Obtengo los valores en la matriz centscal
Ahora vamos a importar la librería nnet, que nos sirve para hacer perceptrones
#install.packages("nnet")
library(nnet)
Ahora lo que hago es coger un conjunto muy grande de los datos para hacer el entrenamiento
conjuntoEntrenamiento <- sample(1:67, 55)
1 NEURONA
Lo que voy a hacer ahora es entrenar la red neuronal con diferente cantidad de neuronas,y voy a ir comparando el resultado…
SIN SOFTMAX
pacientes.1neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=1 )
## # weights: 33
## initial value 61.488463
## iter 10 value 37.642696
## iter 20 value 29.361864
## iter 30 value 26.778716
## iter 40 value 26.540511
## iter 50 value 26.535604
## iter 60 value 26.535528
## iter 70 value 26.535507
## final value 26.535505
## converged
Lo voy a entrenar también con el SOFTMAX = true. Esto optimiza la verosimilitud, no el error cuadrático medio…
CON SOFTMAX
pacientes.1neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=1, softmax = T )
## # weights: 33
## initial value 79.710368
## iter 10 value 62.187877
## iter 20 value 51.198034
## iter 30 value 49.380169
## iter 40 value 48.862758
## iter 50 value 48.806694
## iter 60 value 48.799842
## iter 70 value 48.799159
## iter 80 value 48.798795
## iter 90 value 48.798539
## iter 100 value 48.798505
## final value 48.798505
## stopped after 100 iterations
Una vez que lo tengo entrenado, lo que voy a hacer es calcular el error tanto en el entrenamiento como en el test de cada uno
pacientes.prediccion.1neu <- predict( pacientes.1neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.1neu # Vemos las probabilidades de pertenencia de cada valor
## 1 2 3 4
## 58 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 64 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 20 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 48 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 62 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 19 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 40 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 53 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 43 0.9285029 6.800306e-06 0.07149033 3.040972e-10
## 37 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 46 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 65 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 15 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 3 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 22 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 63 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 59 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 25 0.9285029 6.792986e-06 0.07149033 3.035388e-10
## 14 0.9285024 9.031592e-06 0.07148857 4.935359e-10
## 23 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 57 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 4 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 24 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 32 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 55 0.9285029 5.933458e-06 0.07149116 2.409632e-10
## 29 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 1 0.9285029 6.050182e-06 0.07149104 2.491087e-10
## 36 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 6 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 8 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 67 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 26 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 51 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 41 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 5 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 18 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 33 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 28 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 35 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 30 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 34 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 11 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 21 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 2 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 52 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 44 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 45 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 49 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 10 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 16 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 56 0.9285028 7.046473e-06 0.07149011 3.231224e-10
## 38 0.3999926 0.000000e+00 0.60000738 0.000000e+00
## 42 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 17 0.1904744 5.640926e-01 0.01464957 2.307834e-01
## 12 0.1904744 5.640926e-01 0.01464957 2.307834e-01
Ahora que los tengo todos entrenados, Determinamos cual es la máxima, es decir, la clase a la que hay que asignar los objetos
pacientes.prediccion.1neu.class <- apply( pacientes.prediccion.1neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.1neu.class
## 58 64 20 48 62 19 40 53 43 37 46 65 15 3 22 63 59 25 14 23 57 4 24 32 55 29 1 36 6 8 67 26 51
## 3 2 2 2 2 2 2 2 1 2 2 2 3 2 3 3 2 1 1 3 3 2 2 2 1 2 1 2 2 2 3 3 2
## 41 5 18 33 28 35 30 34 11 21 2 52 44 45 49 10 16 56 38 42 17 12
## 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 3 2 2 2
Lo visualizo en forma de tabla para ir viendo el error
table( pacientes.prediccion.1neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.
##
## pacientes.prediccion.1neu.class 1 2 3 4
## 1 6 0 0 0
## 2 7 22 1 9
## 3 4 0 6 0
Calculo el acierto
sum( diag( table( pacientes.prediccion.1neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.6181818
TEST
pacientes.prediccion.test.1neu <- predict( pacientes.1neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.1neu
## 1 2 3 4
## 7 0.1904744 0.5640926 0.01464957 0.2307834
## 9 0.1904744 0.5640926 0.01464957 0.2307834
## 13 0.1904744 0.5640926 0.01464957 0.2307834
## 27 0.1904744 0.5640926 0.01464957 0.2307834
## 31 0.1904744 0.5640926 0.01464957 0.2307834
## 39 0.1904744 0.5640926 0.01464957 0.2307834
## 47 0.1904744 0.5640926 0.01464957 0.2307834
## 50 0.3999926 0.0000000 0.60000738 0.0000000
## 54 0.1904744 0.5640926 0.01464957 0.2307834
## 60 0.1904744 0.5640926 0.01464957 0.2307834
## 61 0.1904744 0.5640926 0.01464957 0.2307834
## 66 0.1904744 0.5640926 0.01464957 0.2307834
pacientes.prediccion.test.1neu.class <- apply( pacientes.prediccion.test.1neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.1neu.class
## 7 9 13 27 31 39 47 50 54 60 61 66
## 2 2 2 2 2 2 2 3 2 2 2 2
table( pacientes.prediccion.test.1neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##
## pacientes.prediccion.test.1neu.class 2 3 4
## 2 7 1 3
## 3 1 0 0
sum( diag( table( pacientes.prediccion.test.1neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.5833333
2 NEURONAS
A partir de ahora voy a hacer exactamente lo mismo, por lo que haré chunks más grandes para evitar una sobrecarga de chunks, y reduciré la cantidad de comentarios, ya que serán redundantes
SIN SOFTMAX
pacientes.2neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=2 )
## # weights: 62
## initial value 63.050512
## iter 10 value 54.994422
## iter 20 value 54.993678
## iter 30 value 54.992743
## iter 40 value 54.991532
## iter 50 value 54.989914
## iter 60 value 54.987712
## iter 70 value 54.984723
## iter 80 value 54.980498
## iter 90 value 54.973746
## iter 100 value 54.960636
## final value 54.960636
## stopped after 100 iterations
CON SOFTMAX
pacientes.2neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=2, softmax = T )
## # weights: 62
## initial value 95.231099
## iter 10 value 55.850252
## iter 20 value 42.620617
## iter 30 value 41.968605
## iter 40 value 41.045121
## iter 50 value 40.867168
## iter 60 value 40.588893
## iter 70 value 40.418156
## iter 80 value 40.292773
## iter 90 value 40.280697
## final value 40.280556
## converged
pacientes.prediccion.2neu <- predict( pacientes.2neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.2neu # Vemos las probabilidades de pertenencia de cada valor
## 1 2 3 4
## 58 0.71070933 0.054800319 0.19926593 0.03522442
## 64 0.02880870 0.874971439 0.01182984 0.08439003
## 20 0.02880870 0.874971439 0.01182984 0.08439003
## 48 0.02880870 0.874971439 0.01182984 0.08439003
## 62 0.02880870 0.874971439 0.01182984 0.08439003
## 19 0.02880870 0.874971439 0.01182984 0.08439003
## 40 0.71070933 0.054801941 0.19926449 0.03522424
## 53 0.11910423 0.082134418 0.12321729 0.67554406
## 43 0.66331508 0.009141852 0.28314074 0.04440233
## 37 0.02880870 0.874971439 0.01182984 0.08439003
## 46 0.02880870 0.874971439 0.01182984 0.08439003
## 65 0.11910423 0.082134418 0.12321729 0.67554406
## 15 0.66331508 0.009141852 0.28314074 0.04440233
## 3 0.02880870 0.874971439 0.01182984 0.08439003
## 22 0.66331508 0.009141852 0.28314074 0.04440233
## 63 0.55740763 0.021579413 0.30056620 0.12044676
## 59 0.11910423 0.082134418 0.12321729 0.67554406
## 25 0.66331508 0.009141852 0.28314074 0.04440233
## 14 0.66331508 0.009141852 0.28314074 0.04440233
## 23 0.71070933 0.054792679 0.19927271 0.03522528
## 57 0.66331508 0.009141852 0.28314074 0.04440233
## 4 0.11910423 0.082134418 0.12321729 0.67554406
## 24 0.66331508 0.009141852 0.28314074 0.04440233
## 32 0.11910423 0.082134418 0.12321729 0.67554406
## 55 0.66331508 0.009141852 0.28314074 0.04440233
## 29 0.02880870 0.874971439 0.01182984 0.08439003
## 1 0.66331508 0.009141852 0.28314074 0.04440233
## 36 0.55218100 0.335172251 0.09355664 0.01909011
## 6 0.11910423 0.082134418 0.12321729 0.67554406
## 8 0.55218100 0.335172251 0.09355664 0.01909011
## 67 0.55218100 0.335172251 0.09355664 0.01909011
## 26 0.55218100 0.335172251 0.09355664 0.01909011
## 51 0.11910423 0.082134418 0.12321729 0.67554406
## 41 0.55739508 0.021581074 0.30056619 0.12045765
## 5 0.02880870 0.874971439 0.01182984 0.08439003
## 18 0.02880870 0.874971439 0.01182984 0.08439003
## 33 0.02880870 0.874971439 0.01182984 0.08439003
## 28 0.02880870 0.874971439 0.01182984 0.08439003
## 35 0.02880870 0.874971439 0.01182984 0.08439003
## 30 0.02880870 0.874971439 0.01182984 0.08439003
## 34 0.55218100 0.335172251 0.09355664 0.01909011
## 11 0.02880870 0.874971439 0.01182984 0.08439003
## 21 0.02880870 0.874971439 0.01182984 0.08439003
## 2 0.02880870 0.874971439 0.01182984 0.08439003
## 52 0.66331508 0.009141852 0.28314074 0.04440233
## 44 0.02880870 0.874971439 0.01182984 0.08439003
## 45 0.02880898 0.874971206 0.01182992 0.08438989
## 49 0.66331508 0.009141852 0.28314074 0.04440233
## 10 0.02880870 0.874971439 0.01182984 0.08439003
## 16 0.11910423 0.082134418 0.12321729 0.67554406
## 56 0.66331508 0.009141852 0.28314074 0.04440233
## 38 0.66331508 0.009141852 0.28314074 0.04440233
## 42 0.66331508 0.009141852 0.28314074 0.04440233
## 17 0.02880870 0.874971439 0.01182984 0.08439003
## 12 0.11910423 0.082134418 0.12321729 0.67554406
pacientes.prediccion.2neu.class <- apply( pacientes.prediccion.2neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.2neu.class
## 58 64 20 48 62 19 40 53 43 37 46 65 15 3 22 63 59 25 14 23 57 4 24 32 55 29 1 36 6 8 67 26 51
## 1 2 2 2 2 2 1 4 1 2 2 4 1 2 1 1 4 1 1 1 1 4 1 4 1 2 1 1 4 1 1 1 4
## 41 5 18 33 28 35 30 34 11 21 2 52 44 45 49 10 16 56 38 42 17 12
## 1 2 2 2 2 2 2 1 2 2 2 1 2 2 1 2 4 1 1 1 2 4
table( pacientes.prediccion.2neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.
##
## pacientes.prediccion.2neu.class 1 2 3 4
## 1 15 2 6 1
## 2 1 19 0 2
## 4 1 1 1 6
sum( diag( table( pacientes.prediccion.2neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.6363636
TEST
pacientes.prediccion.test.2neu <- predict( pacientes.2neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.2neu
## 1 2 3 4
## 7 0.0288087 0.874971439 0.01182984 0.08439003
## 9 0.0288087 0.874971439 0.01182984 0.08439003
## 13 0.0288087 0.874971439 0.01182984 0.08439003
## 27 0.6633151 0.009141852 0.28314074 0.04440233
## 31 0.0288087 0.874971439 0.01182984 0.08439003
## 39 0.0288087 0.874971439 0.01182984 0.08439003
## 47 0.1191042 0.082134418 0.12321729 0.67554406
## 50 0.5521810 0.335172251 0.09355664 0.01909011
## 54 0.5521810 0.335172251 0.09355664 0.01909011
## 60 0.1191042 0.082134418 0.12321729 0.67554406
## 61 0.1191042 0.082134418 0.12321729 0.67554406
## 66 0.5521810 0.335172251 0.09355664 0.01909011
pacientes.prediccion.test.2neu.class <- apply( pacientes.prediccion.test.2neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.2neu.class
## 7 9 13 27 31 39 47 50 54 60 61 66
## 2 2 2 1 2 2 4 1 1 4 4 1
table( pacientes.prediccion.test.2neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##
## pacientes.prediccion.test.2neu.class 2 3 4
## 1 2 1 1
## 2 4 0 1
## 4 2 0 1
sum( diag( table( pacientes.prediccion.test.2neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.25
3 NEURONAS
SIN SOFTMAX
pacientes.3neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3)
## # weights: 91
## initial value 58.251688
## iter 10 value 54.777417
## iter 20 value 45.587468
## iter 30 value 39.514981
## iter 40 value 38.305560
## iter 50 value 37.799294
## iter 60 value 37.688351
## iter 70 value 37.570805
## iter 80 value 37.008947
## iter 90 value 36.601962
## iter 100 value 36.324574
## final value 36.324574
## stopped after 100 iterations
CON SOFTMAX
pacientes.3neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, softmax = T)
## # weights: 91
## initial value 76.599391
## iter 10 value 33.605302
## iter 20 value 23.650725
## iter 30 value 19.609596
## iter 40 value 18.307377
## iter 50 value 17.679544
## iter 60 value 17.144999
## iter 70 value 16.777208
## iter 80 value 16.660663
## iter 90 value 16.527163
## iter 100 value 16.439378
## final value 16.439378
## stopped after 100 iterations
pacientes.prediccion.3neu <- predict( pacientes.3neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.3neu # Vemos las probabilidades de pertenencia de cada valor
## 1 2 3 4
## 58 1.000000e+00 0.000000e+00 6.212054e-75 1.018472e-218
## 64 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 20 1.961260e-03 9.906932e-01 7.345539e-03 0.000000e+00
## 48 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 62 3.255020e-01 6.740305e-01 4.674916e-04 0.000000e+00
## 19 1.961260e-03 9.906932e-01 7.345539e-03 0.000000e+00
## 40 9.994879e-01 8.583854e-257 5.121161e-04 2.661376e-221
## 53 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 43 1.000000e+00 0.000000e+00 6.212054e-75 1.018472e-218
## 37 3.763569e-02 8.221776e-01 1.401867e-01 0.000000e+00
## 46 6.250942e-71 3.345279e-01 1.650332e-01 5.004389e-01
## 65 6.250942e-71 3.345279e-01 1.650332e-01 5.004389e-01
## 15 5.091812e-01 0.000000e+00 4.908188e-01 0.000000e+00
## 3 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 22 5.091812e-01 0.000000e+00 4.908188e-01 0.000000e+00
## 63 2.141547e-01 5.814911e-04 7.852639e-01 0.000000e+00
## 59 4.850968e-233 0.000000e+00 3.847023e-237 1.000000e+00
## 25 1.000000e+00 0.000000e+00 1.717972e-74 0.000000e+00
## 14 1.000000e+00 0.000000e+00 6.212054e-75 1.018472e-218
## 23 1.000000e+00 0.000000e+00 1.125017e-73 0.000000e+00
## 57 2.151012e-01 3.489120e-05 7.848639e-01 0.000000e+00
## 4 6.250942e-71 3.345279e-01 1.650332e-01 5.004389e-01
## 24 4.850968e-233 0.000000e+00 3.847023e-237 1.000000e+00
## 32 6.250942e-71 3.345279e-01 1.650332e-01 5.004389e-01
## 55 1.000000e+00 0.000000e+00 1.125017e-73 0.000000e+00
## 29 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 1 8.286331e-01 0.000000e+00 1.713669e-01 0.000000e+00
## 36 1.961260e-03 9.906932e-01 7.345539e-03 0.000000e+00
## 6 4.850968e-233 0.000000e+00 3.847023e-237 1.000000e+00
## 8 7.539221e-02 6.442441e-01 2.803636e-01 0.000000e+00
## 67 8.286331e-01 0.000000e+00 1.713669e-01 0.000000e+00
## 26 3.492835e-01 4.504237e-02 6.056741e-01 0.000000e+00
## 51 4.850968e-233 0.000000e+00 3.847023e-237 1.000000e+00
## 41 2.160104e-15 0.000000e+00 1.000000e+00 3.370835e-297
## 5 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 18 6.250942e-71 3.345279e-01 1.650332e-01 5.004389e-01
## 33 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 28 1.222714e-81 0.000000e+00 1.809273e-85 1.000000e+00
## 35 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 30 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 34 9.136828e-02 5.690449e-01 3.395868e-01 0.000000e+00
## 11 6.018280e-16 1.000000e+00 2.108497e-17 0.000000e+00
## 21 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 2 3.255020e-01 6.740305e-01 4.674916e-04 0.000000e+00
## 52 8.286331e-01 0.000000e+00 1.713669e-01 0.000000e+00
## 44 3.255020e-01 6.740305e-01 4.674916e-04 0.000000e+00
## 45 1.961260e-03 9.906932e-01 7.345539e-03 0.000000e+00
## 49 8.286331e-01 0.000000e+00 1.713669e-01 0.000000e+00
## 10 0.000000e+00 1.000000e+00 0.000000e+00 0.000000e+00
## 16 4.850968e-233 0.000000e+00 3.847023e-237 1.000000e+00
## 56 8.286331e-01 0.000000e+00 1.713669e-01 0.000000e+00
## 38 8.286331e-01 0.000000e+00 1.713669e-01 0.000000e+00
## 42 1.000000e+00 0.000000e+00 6.212054e-75 1.018472e-218
## 17 6.250942e-71 3.345279e-01 1.650332e-01 5.004389e-01
## 12 9.988794e-01 7.344799e-62 1.120587e-03 0.000000e+00
pacientes.prediccion.3neu.class <- apply( pacientes.prediccion.3neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class
## 58 64 20 48 62 19 40 53 43 37 46 65 15 3 22 63 59 25 14 23 57 4 24 32 55 29 1 36 6 8 67 26 51
## 1 2 2 2 2 2 1 2 1 2 4 4 1 2 1 3 4 1 1 1 3 4 4 4 1 2 1 2 4 2 1 3 4
## 41 5 18 33 28 35 30 34 11 21 2 52 44 45 49 10 16 56 38 42 17 12
## 3 2 4 2 4 2 2 2 2 2 2 1 2 2 1 2 4 1 1 1 4 1
table( pacientes.prediccion.3neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.
##
## pacientes.prediccion.3neu.class 1 2 3 4
## 1 15 0 2 0
## 2 2 20 0 0
## 3 0 0 4 0
## 4 0 2 1 9
sum( diag( table( pacientes.prediccion.3neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.8727273
TEST
pacientes.prediccion.test.3neu <- predict( pacientes.3neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu
## 1 2 3 4
## 7 1.961260e-03 0.9906932 7.345539e-03 0.0000000
## 9 0.000000e+00 1.0000000 0.000000e+00 0.0000000
## 13 0.000000e+00 1.0000000 0.000000e+00 0.0000000
## 27 3.255020e-01 0.6740305 4.674916e-04 0.0000000
## 31 3.255020e-01 0.6740305 4.674916e-04 0.0000000
## 39 1.961260e-03 0.9906932 7.345539e-03 0.0000000
## 47 6.250942e-71 0.3345279 1.650332e-01 0.5004389
## 50 8.286331e-01 0.0000000 1.713669e-01 0.0000000
## 54 4.850968e-233 0.0000000 3.847023e-237 1.0000000
## 60 4.850968e-233 0.0000000 3.847023e-237 1.0000000
## 61 8.286331e-01 0.0000000 1.713669e-01 0.0000000
## 66 1.961260e-03 0.9906932 7.345539e-03 0.0000000
pacientes.prediccion.test.3neu.class <- apply( pacientes.prediccion.test.3neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class
## 7 9 13 27 31 39 47 50 54 60 61 66
## 2 2 2 2 2 2 4 1 4 4 1 2
table( pacientes.prediccion.test.3neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##
## pacientes.prediccion.test.3neu.class 2 3 4
## 1 2 0 0
## 2 5 0 2
## 4 1 1 1
sum( diag( table( pacientes.prediccion.test.3neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.25
3 NEURONAS
Con Decay
SIN SOFTMAX
pacientes.3neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, decay = 0.2)
## # weights: 91
## initial value 57.877703
## iter 10 value 33.642512
## iter 20 value 32.592934
## iter 30 value 32.441593
## iter 40 value 32.439268
## final value 32.439244
## converged
CON SOFTMAX
pacientes.3neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, softmax = T, decay = 0.03)
## # weights: 91
## initial value 90.156445
## iter 10 value 45.316111
## iter 20 value 34.603741
## iter 30 value 30.983521
## iter 40 value 30.607144
## iter 50 value 29.426519
## iter 60 value 28.501952
## iter 70 value 28.188499
## iter 80 value 28.146010
## iter 90 value 28.144810
## iter 100 value 28.144779
## final value 28.144779
## stopped after 100 iterations
pacientes.prediccion.3neu.decay <- predict( pacientes.3neu.decay, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.3neu.decay # Vemos las probabilidades de pertenencia de cada valor
## 1 2 3 4
## 58 0.7679787126 0.0103982806 1.147889e-01 1.068341e-01
## 64 0.0106974446 0.9883667056 3.887315e-04 5.471183e-04
## 20 0.0302509318 0.9671377321 1.822457e-03 7.888789e-04
## 48 0.0528903042 0.9413580428 2.920762e-03 2.830891e-03
## 62 0.2981520944 0.4651088691 1.131191e-03 2.356078e-01
## 19 0.0113029555 0.9876916726 3.554443e-04 6.499276e-04
## 40 0.6871742845 0.1988829591 3.394030e-02 8.000246e-02
## 53 0.3742315313 0.3056558438 3.141989e-01 5.913735e-03
## 43 0.7552402919 0.0088075878 8.350440e-02 1.524477e-01
## 37 0.1271427734 0.8484637556 2.329877e-02 1.094705e-03
## 46 0.1676087728 0.8079759521 2.227499e-02 2.140285e-03
## 65 0.2396064156 0.0009677906 2.798057e-03 7.566277e-01
## 15 0.3573931080 0.0718066946 5.693312e-01 1.469041e-03
## 3 0.1217083106 0.8635835124 1.306976e-02 1.638419e-03
## 22 0.3573931080 0.0718066946 5.693312e-01 1.469041e-03
## 63 0.0066621817 0.0815037005 9.118339e-01 1.862670e-07
## 59 0.2427596641 0.0010952142 2.869975e-03 7.532751e-01
## 25 0.7219531330 0.0740965427 1.072749e-01 9.667546e-02
## 14 0.7306727477 0.0559153712 9.177037e-02 1.216415e-01
## 23 0.7864072639 0.0404737225 8.790055e-02 8.521846e-02
## 57 0.0043604852 0.0664906652 9.291488e-01 7.048382e-08
## 4 0.2294731329 0.0009000442 2.556641e-03 7.670702e-01
## 24 0.3107435860 0.0022663485 4.022607e-03 6.829675e-01
## 32 0.4447636193 0.0678424693 4.844904e-01 2.903555e-03
## 55 0.7640746230 0.0132297441 1.372656e-01 8.543007e-02
## 29 0.0084068879 0.9818181106 9.766836e-03 8.165289e-06
## 1 0.7358975406 0.0561727078 1.192000e-01 8.872980e-02
## 36 0.0414478260 0.8388234449 1.197047e-01 2.405488e-05
## 6 0.1270858768 0.0224926764 1.453752e-04 8.502761e-01
## 8 0.1059463299 0.8765617987 1.651314e-02 9.787309e-04
## 67 0.7264203053 0.1307760847 4.259480e-02 1.002088e-01
## 26 0.3640379243 0.0532514597 5.810576e-01 1.653041e-03
## 51 0.3036070634 0.0017546153 4.548873e-03 6.900894e-01
## 41 0.3862300074 0.3133224766 2.937427e-01 6.704826e-03
## 5 0.0017960977 0.9910177417 7.185876e-03 2.844798e-07
## 18 0.0864848544 0.9019490719 7.494764e-03 4.071309e-03
## 33 0.0383136732 0.9499347235 1.160945e-02 1.421558e-04
## 28 0.2674172454 0.0112584511 1.413935e-03 7.199104e-01
## 35 0.2041949463 0.7575601142 3.606194e-02 2.183002e-03
## 30 0.1468180121 0.8319323799 1.949832e-02 1.751291e-03
## 34 0.1029483152 0.8804739476 1.561442e-02 9.633131e-04
## 11 0.0133321645 0.9852269432 2.935288e-04 1.147363e-03
## 21 0.0086222593 0.9906304020 2.717197e-04 4.756189e-04
## 2 0.1348742978 0.8517148052 1.084343e-02 2.567465e-03
## 52 0.7724486803 0.0379281894 1.371404e-01 5.248275e-02
## 44 0.3218305454 0.6206991013 5.254459e-02 4.925762e-03
## 45 0.0006120918 0.9939717415 5.416132e-03 3.469093e-08
## 49 0.7146295970 0.0380532881 6.262799e-02 1.846891e-01
## 10 0.1735671798 0.8101411454 1.181961e-02 4.472062e-03
## 16 0.0850671923 0.0232171957 5.222864e-05 8.916634e-01
## 56 0.7189655526 0.0812495439 1.045662e-01 9.521874e-02
## 38 0.1158515959 0.0526753603 8.313345e-01 1.385837e-04
## 42 0.7282826031 0.0543153886 8.511025e-02 1.322918e-01
## 17 0.0736966547 0.0390429330 3.007922e-05 8.872303e-01
## 12 0.7576194031 0.0830691557 4.272809e-02 1.165834e-01
pacientes.prediccion.3neu.class.decay <- apply( pacientes.prediccion.3neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class.decay
## 58 64 20 48 62 19 40 53 43 37 46 65 15 3 22 63 59 25 14 23 57 4 24 32 55 29 1 36 6 8 67 26 51
## 1 2 2 2 2 2 1 1 1 2 2 4 3 2 3 3 4 1 1 1 3 4 4 3 1 2 1 2 4 2 1 3 4
## 41 5 18 33 28 35 30 34 11 21 2 52 44 45 49 10 16 56 38 42 17 12
## 1 2 2 2 4 2 2 2 2 2 2 1 2 2 1 2 4 1 3 1 4 1
table( pacientes.prediccion.3neu.class.decay, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.
##
## pacientes.prediccion.3neu.class.decay 1 2 3 4
## 1 14 1 1 0
## 2 2 21 0 0
## 3 1 0 6 0
## 4 0 0 0 9
sum( diag( table( pacientes.prediccion.3neu.class.decay, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.9090909
TEST
pacientes.prediccion.test.3neu.decay <- predict( pacientes.3neu.decay, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu.decay
## 1 2 3 4
## 7 0.364476136 0.345786443 2.838285e-01 5.908875e-03
## 9 0.010616377 0.980493648 8.878743e-03 1.123247e-05
## 13 0.116189730 0.869203314 1.315165e-02 1.455303e-03
## 27 0.360854000 0.312510282 3.213286e-01 5.307142e-03
## 31 0.073522449 0.036796952 3.084546e-05 8.896498e-01
## 39 0.001880073 0.991911534 6.208027e-03 3.654609e-07
## 47 0.536161004 0.304241235 1.516979e-01 7.899882e-03
## 50 0.026775789 0.867960402 1.052455e-01 1.832813e-05
## 54 0.443265696 0.319789482 2.338232e-01 3.121604e-03
## 60 0.370344654 0.004013806 6.521102e-03 6.191204e-01
## 61 0.718997842 0.040518428 6.664048e-02 1.738433e-01
## 66 0.008077526 0.982998019 8.918423e-03 6.031440e-06
pacientes.prediccion.test.3neu.class.decay <- apply( pacientes.prediccion.test.3neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class.decay
## 7 9 13 27 31 39 47 50 54 60 61 66
## 1 2 2 1 4 2 1 2 1 4 1 2
table( pacientes.prediccion.test.3neu.class.decay , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##
## pacientes.prediccion.test.3neu.class.decay 2 3 4
## 1 1 1 3
## 2 5 0 0
## 4 2 0 0
sum( diag( table( pacientes.prediccion.test.3neu.class.decay, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.08333333
5 NEURONAS
SIN SOFTMAX
pacientes.5neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5 )
## # weights: 149
## initial value 66.628558
## iter 10 value 38.011603
## iter 20 value 34.721185
## iter 30 value 34.420359
## iter 40 value 34.399845
## iter 50 value 29.520958
## iter 60 value 25.763564
## iter 70 value 24.720210
## iter 80 value 24.357999
## iter 90 value 23.839427
## iter 100 value 23.785900
## final value 23.785900
## stopped after 100 iterations
CON SOFTMAX
pacientes.5neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, softmax = T )
## # weights: 149
## initial value 75.522373
## iter 10 value 23.240210
## iter 20 value 8.777658
## iter 30 value 5.863966
## iter 40 value 4.226141
## iter 50 value 4.001740
## iter 60 value 3.926919
## iter 70 value 3.722510
## iter 80 value 3.703069
## iter 90 value 3.687182
## iter 100 value 3.671219
## final value 3.671219
## stopped after 100 iterations
pacientes.prediccion.5neu <- predict( pacientes.5neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.5neu # Vemos las probabilidades de pertenencia de cada valor
## 1 2 3 4
## 58 9.990872e-01 4.067044e-13 9.095810e-04 3.247700e-06
## 64 1.455906e-23 9.999997e-01 2.023309e-08 2.454787e-07
## 20 1.531362e-17 1.000000e+00 1.243752e-16 6.972984e-18
## 48 5.372895e-06 9.999946e-01 2.042074e-22 3.411554e-18
## 62 9.969315e-01 3.068546e-03 2.352762e-27 8.112274e-15
## 19 1.919294e-23 9.999998e-01 3.079978e-08 1.912264e-07
## 40 1.000000e+00 8.263522e-16 1.927758e-33 1.254972e-14
## 53 3.000268e-03 9.952811e-01 5.564007e-18 1.718651e-03
## 43 1.000000e+00 3.458377e-12 2.069562e-28 6.203913e-14
## 37 2.553518e-03 9.953747e-01 2.071771e-03 2.897095e-27
## 46 6.293106e-05 9.999371e-01 9.690762e-21 5.584244e-09
## 65 8.286692e-04 1.375646e-13 5.503695e-23 9.991713e-01
## 15 4.975489e-01 1.104968e-03 5.013230e-01 2.309793e-05
## 3 3.132212e-21 9.999857e-01 3.792830e-09 1.430194e-05
## 22 4.975489e-01 1.104968e-03 5.013230e-01 2.309793e-05
## 63 1.966141e-10 1.069792e-03 9.989302e-01 5.657061e-23
## 59 4.565790e-07 1.139090e-14 9.193728e-23 9.999995e-01
## 25 1.000000e+00 9.193806e-17 1.081760e-34 7.356890e-15
## 14 1.000000e+00 7.316604e-20 1.486796e-14 2.586208e-16
## 23 1.000000e+00 7.697153e-12 5.072052e-32 7.629412e-15
## 57 1.414682e-03 1.771405e-09 9.985853e-01 3.707498e-16
## 4 8.255132e-04 1.373907e-13 5.505143e-23 9.991745e-01
## 24 8.585992e-07 3.118668e-04 8.678121e-10 9.996873e-01
## 32 7.538297e-10 2.539749e-11 1.000000e+00 4.491291e-14
## 55 9.990872e-01 4.067044e-13 9.095810e-04 3.247700e-06
## 29 5.845915e-05 9.999415e-01 8.433766e-21 5.973842e-09
## 1 9.990872e-01 4.067150e-13 9.095789e-04 3.247796e-06
## 36 2.491658e-01 7.508321e-01 2.061895e-06 4.374214e-31
## 6 2.967806e-11 1.306713e-15 7.018470e-19 1.000000e+00
## 8 2.490676e-01 7.509304e-01 2.063642e-06 4.378812e-31
## 67 9.990941e-01 4.118303e-13 9.025540e-04 3.329059e-06
## 26 1.553407e-16 1.094514e-11 1.000000e+00 5.270691e-19
## 51 8.291867e-04 1.376148e-13 5.505657e-23 9.991708e-01
## 41 5.040302e-05 6.862913e-04 9.992633e-01 1.811580e-10
## 5 1.461311e-10 1.000000e+00 5.412806e-21 1.198829e-21
## 18 9.241526e-06 9.969104e-01 1.079534e-03 2.000858e-03
## 33 1.462613e-10 1.000000e+00 5.406666e-21 1.197117e-21
## 28 6.644885e-14 6.296516e-17 2.727677e-22 1.000000e+00
## 35 1.501007e-23 9.999997e-01 2.122238e-08 2.381839e-07
## 30 8.100705e-17 1.000000e+00 1.838271e-12 1.086499e-10
## 34 2.491594e-01 7.508386e-01 2.062010e-06 4.374515e-31
## 11 1.213866e-05 9.999878e-01 7.201941e-20 9.390494e-08
## 21 1.461514e-23 9.999997e-01 2.035503e-08 2.445489e-07
## 2 2.628855e-17 1.000000e+00 5.950432e-17 2.704445e-18
## 52 1.000000e+00 4.200648e-24 1.052633e-26 4.890416e-33
## 44 9.059139e-04 9.990106e-01 9.034257e-11 8.350497e-05
## 45 2.491658e-01 7.508321e-01 2.061895e-06 4.374214e-31
## 49 1.000000e+00 8.761780e-20 1.341178e-14 3.705688e-16
## 10 1.543266e-22 9.999974e-01 5.957397e-08 2.582372e-06
## 16 7.719772e-14 6.590696e-17 3.283983e-22 1.000000e+00
## 56 1.000000e+00 1.170837e-22 3.665056e-21 5.250871e-24
## 38 4.368435e-03 6.983171e-10 9.956316e-01 1.132484e-15
## 42 1.000000e+00 7.316505e-20 1.486748e-14 2.586112e-16
## 17 5.962830e-14 1.841303e-03 5.279295e-15 9.981587e-01
## 12 9.996571e-01 1.014938e-12 1.942382e-25 3.428995e-04
pacientes.prediccion.5neu.class <- apply( pacientes.prediccion.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.class
## 58 64 20 48 62 19 40 53 43 37 46 65 15 3 22 63 59 25 14 23 57 4 24 32 55 29 1 36 6 8 67 26 51
## 1 2 2 2 1 2 1 2 1 2 2 4 3 2 3 3 4 1 1 1 3 4 4 3 1 2 1 2 4 2 1 3 4
## 41 5 18 33 28 35 30 34 11 21 2 52 44 45 49 10 16 56 38 42 17 12
## 3 2 2 2 4 2 2 2 2 2 2 1 2 2 1 2 4 1 3 1 4 1
table( pacientes.prediccion.5neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.
##
## pacientes.prediccion.5neu.class 1 2 3 4
## 1 15 0 0 0
## 2 1 22 0 0
## 3 1 0 7 0
## 4 0 0 0 9
sum( diag( table( pacientes.prediccion.5neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.9636364
TEST
pacientes.prediccion.test.5neu <- predict( pacientes.5neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.5neu
## 1 2 3 4
## 7 6.317154e-02 1.234610e-09 9.368285e-01 1.092355e-14
## 9 8.003683e-18 1.000000e+00 7.357544e-12 3.434653e-10
## 13 1.758551e-10 1.000000e+00 7.222979e-21 9.965042e-22
## 27 6.612330e-14 6.100759e-17 2.690783e-22 1.000000e+00
## 31 9.969195e-01 3.080512e-03 2.364486e-27 8.115007e-15
## 39 1.462613e-10 1.000000e+00 5.406666e-21 1.197117e-21
## 47 1.000000e+00 1.143405e-11 3.090335e-21 2.106782e-20
## 50 5.039836e-05 6.860120e-04 9.992636e-01 1.810360e-10
## 54 8.242159e-07 3.032882e-04 8.551893e-10 9.996959e-01
## 60 9.980832e-01 1.916843e-03 2.687697e-18 5.888020e-12
## 61 1.000000e+00 7.551436e-20 1.471507e-14 2.734751e-16
## 66 5.203896e-10 1.000000e+00 3.974874e-20 3.384332e-22
pacientes.prediccion.test.5neu.class <- apply( pacientes.prediccion.test.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.5neu.class
## 7 9 13 27 31 39 47 50 54 60 61 66
## 3 2 2 4 1 2 1 3 4 1 1 2
table( pacientes.prediccion.test.5neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##
## pacientes.prediccion.test.5neu.class 2 3 4
## 1 3 0 1
## 2 4 0 0
## 3 1 0 1
## 4 0 1 1
sum( diag( table( pacientes.prediccion.test.5neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.3333333
5 NEURONAS
CON DECAY
SIN SOFTMAX
pacientes.5neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, decay=0.1)
## # weights: 149
## initial value 68.471469
## iter 10 value 31.190861
## iter 20 value 25.914107
## iter 30 value 25.453826
## iter 40 value 25.340087
## iter 50 value 25.334125
## iter 60 value 25.329271
## iter 70 value 25.294325
## iter 80 value 25.290492
## iter 90 value 25.290192
## final value 25.290186
## converged
CON SOFTMAX
pacientes.5neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, softmax = T, decay = 0.05)
## # weights: 149
## initial value 94.855829
## iter 10 value 38.472018
## iter 20 value 27.875678
## iter 30 value 25.720115
## iter 40 value 24.781900
## iter 50 value 23.161076
## iter 60 value 21.347450
## iter 70 value 21.175652
## iter 80 value 21.172428
## final value 21.172375
## converged
pacientes.prediccion.5neu.decay <- predict( pacientes.5neu.decay, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.5neu.decay # Vemos las probabilidades de pertenencia de cada valor
## 1 2 3 4
## 58 0.9745930537 0.0002431534 0.0216380366 0.0035257564
## 64 0.0039060215 0.9418994026 0.0043334349 0.0498611410
## 20 0.0138944886 0.9647755255 0.0026213557 0.0187086302
## 48 0.0693226431 0.8557509505 0.0202889319 0.0546374745
## 62 0.6446851687 0.3280615304 0.0009498972 0.0263034038
## 19 0.0048631012 0.9139359474 0.0122508868 0.0689500645
## 40 0.9800491144 0.0164744064 0.0001004295 0.0033760497
## 53 0.0327260675 0.9540401184 0.0060740227 0.0071597914
## 43 0.9813231257 0.0016598012 0.0040152084 0.0130018647
## 37 0.1760785548 0.7407231372 0.0826634988 0.0005348092
## 46 0.1337513879 0.8149415721 0.0252490611 0.0260579789
## 65 0.0326396566 0.0029239461 0.0330636457 0.9313727516
## 15 0.3880407824 0.1444211013 0.4601414146 0.0073967018
## 3 0.0040999053 0.9901799145 0.0035019421 0.0022182381
## 22 0.3880407824 0.1444211013 0.4601414146 0.0073967018
## 63 0.0396325144 0.0928112645 0.8441384284 0.0234177927
## 59 0.0582464198 0.0025084408 0.0560413704 0.8832037690
## 25 0.9071647172 0.0243146234 0.0012722157 0.0672484437
## 14 0.8708359795 0.0008136957 0.1164863265 0.0118639983
## 23 0.9965529210 0.0029016990 0.0000270992 0.0005182808
## 57 0.0155890858 0.0468005531 0.9136125569 0.0239978041
## 4 0.0081359546 0.0013702988 0.0103106359 0.9801831106
## 24 0.1193727394 0.0056562441 0.0118549555 0.8631160610
## 32 0.0728159509 0.0426374198 0.6279379117 0.2566087176
## 55 0.8762969956 0.0017588819 0.1181873909 0.0037567316
## 29 0.0677075235 0.9095775429 0.0098956860 0.0128192476
## 1 0.9431640168 0.0019218621 0.0248748509 0.0300392702
## 36 0.1092052954 0.7975856119 0.0928701212 0.0003389715
## 6 0.0051076360 0.0281912979 0.1241793724 0.8425216937
## 8 0.3301612748 0.6419238113 0.0276691211 0.0002457928
## 67 0.8957760915 0.0280580404 0.0536831742 0.0224826938
## 26 0.1306028823 0.1355176717 0.7250055843 0.0088738617
## 51 0.2819703644 0.0584657374 0.0053375407 0.6542263575
## 41 0.0647900395 0.0460547126 0.7727965281 0.1163587198
## 5 0.0106190187 0.9880930045 0.0004557409 0.0008322359
## 18 0.0738343222 0.8496510918 0.0114666591 0.0650479269
## 33 0.0196747747 0.9772055826 0.0009800025 0.0021396403
## 28 0.0038671654 0.0872869853 0.0241134073 0.8847324419
## 35 0.0141744622 0.9300483224 0.0437731150 0.0120041004
## 30 0.0088556286 0.9647146451 0.0246400632 0.0017896631
## 34 0.3616680396 0.6175256448 0.0205990670 0.0002072486
## 11 0.0140634517 0.9019629404 0.0035012612 0.0804723467
## 21 0.0001448403 0.9962735031 0.0019436189 0.0016380377
## 2 0.0211349393 0.9774218646 0.0004055371 0.0010376591
## 52 0.9704610678 0.0205885470 0.0056744192 0.0032759659
## 44 0.1026238067 0.7426047720 0.0192502142 0.1355212071
## 45 0.0026368016 0.9547317114 0.0421403575 0.0004911295
## 49 0.7277740868 0.0125901900 0.0017211431 0.2579145801
## 10 0.0523652634 0.8288465351 0.0463712427 0.0724169589
## 16 0.0181127187 0.0207083744 0.0304533566 0.9307255503
## 56 0.9732925338 0.0125337269 0.0133876459 0.0007860934
## 38 0.0501407132 0.0040586193 0.8941159989 0.0516846685
## 42 0.9540190654 0.0061912379 0.0224898988 0.0172997979
## 17 0.0125181633 0.2851548673 0.0543684504 0.6479585190
## 12 0.9250090508 0.0592879743 0.0005230293 0.0151799456
pacientes.prediccion.5neu.decay.class <- apply( pacientes.prediccion.5neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.decay.class
## 58 64 20 48 62 19 40 53 43 37 46 65 15 3 22 63 59 25 14 23 57 4 24 32 55 29 1 36 6 8 67 26 51
## 1 2 2 2 1 2 1 2 1 2 2 4 3 2 3 3 4 1 1 1 3 4 4 3 1 2 1 2 4 2 1 3 4
## 41 5 18 33 28 35 30 34 11 21 2 52 44 45 49 10 16 56 38 42 17 12
## 3 2 2 2 4 2 2 2 2 2 2 1 2 2 1 2 4 1 3 1 4 1
table( pacientes.prediccion.5neu.decay.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) # Lo vemos en forma de tabla.
##
## pacientes.prediccion.5neu.decay.class 1 2 3 4
## 1 15 0 0 0
## 2 1 22 0 0
## 3 1 0 7 0
## 4 0 0 0 9
sum( diag( table( pacientes.prediccion.5neu.decay.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.9636364
TEST
pacientes.prediccion.test.decay.5neu <- predict( pacientes.5neu.decay, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.decay.5neu
## 1 2 3 4
## 7 0.0043672094 0.111312323 0.8587005750 0.0256198930
## 9 0.0004080722 0.985384739 0.0060067515 0.0082004374
## 13 0.0720000940 0.927427826 0.0003319562 0.0002401241
## 27 0.9239430468 0.006701475 0.0310369658 0.0383185126
## 31 0.6591439560 0.296413667 0.0011662051 0.0432761723
## 39 0.0105713518 0.989009321 0.0001209546 0.0002983725
## 47 0.3317902147 0.297847497 0.0939840887 0.2763782001
## 50 0.2872836433 0.019605471 0.6457037909 0.0474070953
## 54 0.7449101942 0.099528387 0.0213839517 0.1341774675
## 60 0.2258285050 0.252880619 0.0128983335 0.5083925427
## 61 0.7512688030 0.007044051 0.0020697753 0.2396173706
## 66 0.0008124804 0.997887526 0.0007457317 0.0005542623
pacientes.prediccion.test.decay.5neu.class <- apply( pacientes.prediccion.test.decay.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.decay.5neu.class
## 7 9 13 27 31 39 47 50 54 60 61 66
## 3 2 2 1 1 2 1 3 1 4 1 2
table( pacientes.prediccion.test.decay.5neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##
## pacientes.prediccion.test.decay.5neu.class 2 3 4
## 1 2 1 2
## 2 4 0 0
## 3 1 0 1
## 4 1 0 0
sum( diag( table( pacientes.prediccion.test.decay.5neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.25
Importo los datos:
dataset.resultados <- read.csv2("C:/Users/jorge/Desktop/Documentos Clase/Universidad/4ºCarrera/1er Cuatrimestre/Inteligencia Artificial/Trabajo Fin de Asignatura/Resultados.txt")
Ahora voy a sacar un gráfico donde comparo los resultados.
#install.packages("plotly")
library("plotly")
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
tipos = dataset.resultados[, 1]
real = dataset.resultados[, 2]
practico = dataset.resultados[, 3]
p<- plot_ly(dataset.resultados, x = ~tipos, y = ~real, type = 'bar', name = 'Real') %>% add_trace(y = ~practico, name = 'Práctico') %>% layout(yaxis = list(title = 'Porcentaje'), barmode = 'group')
p
#Mostramos el gráfico interactivo
#install.packages("class")
library("class")
# Para hacer la predicción con knn, voy a coger los grupos de una manera distinta:
conjuntoEntrenamiento = matriz.pacientes.datos.centscal[1:55, 1:24]
conjuntoTest = matriz.pacientes.datos.centscal[56:67, 1:24]
# Utilizo por supuesto la matriz de centrado y escalado
etiquetasEntrenamiento = matriz.pacientes.etiquetas[1:55, 25]
etiquetasTest = matriz.pacientes.etiquetas[56:67, 25]
conjuntoEntrenamiento
conjuntoTest
etiquetasEntrenamiento
etiquetasTest
Para K = 8…
# K = 8
prediccion.knn.8 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 8)
prediccion.knn.8
## [1] 1 2 2 1 2 1 2 2 4 1 2 2
## Levels: 1 2 3 4
Sacamos crosstable:
#install.packages("gmodels")
library("gmodels")
CrossTable(x = etiquetasTest , y = prediccion.knn.8, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 12
##
##
## | prediccion.knn.8
## etiquetasTest | 1 | 2 | 4 | Row Total |
## --------------|-----------|-----------|-----------|-----------|
## 1 | 1 | 3 | 0 | 4 |
## | 0.250 | 0.750 | 0.000 | 0.333 |
## | 0.250 | 0.429 | 0.000 | |
## | 0.083 | 0.250 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 2 | 1 | 2 | 1 | 4 |
## | 0.250 | 0.500 | 0.250 | 0.333 |
## | 0.250 | 0.286 | 1.000 | |
## | 0.083 | 0.167 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
## 3 | 0 | 2 | 0 | 2 |
## | 0.000 | 1.000 | 0.000 | 0.167 |
## | 0.000 | 0.286 | 0.000 | |
## | 0.000 | 0.167 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 4 | 2 | 0 | 0 | 2 |
## | 1.000 | 0.000 | 0.000 | 0.167 |
## | 0.500 | 0.000 | 0.000 | |
## | 0.167 | 0.000 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## Column Total | 4 | 7 | 1 | 12 |
## | 0.333 | 0.583 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
##
##
Para K = 6
# K = 6
prediccion.knn.6 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 6)
prediccion.knn.6
## [1] 1 2 2 1 2 1 2 2 2 1 2 2
## Levels: 1 2 3 4
CrossTable(x = etiquetasTest , y = prediccion.knn.6, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 12
##
##
## | prediccion.knn.6
## etiquetasTest | 1 | 2 | Row Total |
## --------------|-----------|-----------|-----------|
## 1 | 1 | 3 | 4 |
## | 0.250 | 0.750 | 0.333 |
## | 0.250 | 0.375 | |
## | 0.083 | 0.250 | |
## --------------|-----------|-----------|-----------|
## 2 | 1 | 3 | 4 |
## | 0.250 | 0.750 | 0.333 |
## | 0.250 | 0.375 | |
## | 0.083 | 0.250 | |
## --------------|-----------|-----------|-----------|
## 3 | 0 | 2 | 2 |
## | 0.000 | 1.000 | 0.167 |
## | 0.000 | 0.250 | |
## | 0.000 | 0.167 | |
## --------------|-----------|-----------|-----------|
## 4 | 2 | 0 | 2 |
## | 1.000 | 0.000 | 0.167 |
## | 0.500 | 0.000 | |
## | 0.167 | 0.000 | |
## --------------|-----------|-----------|-----------|
## Column Total | 4 | 8 | 12 |
## | 0.333 | 0.667 | |
## --------------|-----------|-----------|-----------|
##
##
Para k = 10
# K = 10
prediccion.knn.10 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 10)
prediccion.knn.10
## [1] 1 2 1 1 2 1 2 2 4 1 2 2
## Levels: 1 2 3 4
CrossTable(x = etiquetasTest , y = prediccion.knn.10, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 12
##
##
## | prediccion.knn.10
## etiquetasTest | 1 | 2 | 4 | Row Total |
## --------------|-----------|-----------|-----------|-----------|
## 1 | 2 | 2 | 0 | 4 |
## | 0.500 | 0.500 | 0.000 | 0.333 |
## | 0.400 | 0.333 | 0.000 | |
## | 0.167 | 0.167 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 2 | 1 | 2 | 1 | 4 |
## | 0.250 | 0.500 | 0.250 | 0.333 |
## | 0.200 | 0.333 | 1.000 | |
## | 0.083 | 0.167 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
## 3 | 0 | 2 | 0 | 2 |
## | 0.000 | 1.000 | 0.000 | 0.167 |
## | 0.000 | 0.333 | 0.000 | |
## | 0.000 | 0.167 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## 4 | 2 | 0 | 0 | 2 |
## | 1.000 | 0.000 | 0.000 | 0.167 |
## | 0.400 | 0.000 | 0.000 | |
## | 0.167 | 0.000 | 0.000 | |
## --------------|-----------|-----------|-----------|-----------|
## Column Total | 5 | 6 | 1 | 12 |
## | 0.417 | 0.500 | 0.083 | |
## --------------|-----------|-----------|-----------|-----------|
##
##